home *** CD-ROM | disk | FTP | other *** search
/ QRZ! Ham Radio 8 / QRZ Ham Radio Callsign Database - Volume 8.iso / pc / files / ant_nec / nec81tar.z / nec81tar / hintg.f < prev    next >
Text File  |  1991-05-13  |  11KB  |  473 lines
  1. C $TITLE: 'HINTG'
  2. C $NOFLOATCALLS
  3. C
  4. C
  5. C
  6.       SUBROUTINE HINTG (XI,YI,ZI)
  7. C     HINTG COMPUTES THE H FIELD OF A PATCH CURRENT
  8.       COMPLEX*16 EXK,EYK,EZK,EXS,EYS,EZS,EXC,EYC,EZC,ZRATI,ZRATI2,
  9.      1 GAM,F1X,F1Y,F1Z,F2X,F2Y,F2Z,RRV,RRH,T1,FRATI
  10.       INTEGER*4 IND1,IND2
  11.       REAL*8 FPI,TP,XI,YI,ZI,RX,RY,RZ,SR,CR,CTH,R,RK,RSQ,XYMAG
  12.       REAL*4 T1XJ,T1YJ,T1ZJ,T2XJ,T2YJ,T2ZJ,CABJ,SABJ,SALPJ,B
  13.       COMMON/DATAJ/S,B,XJ,YJ,ZJ,CABJ,SABJ,SALPJ,EXK,EYK,EZK,EXS,EYS,
  14.      1 EZS,EXC,EYC,EZC,RKH,IND1,IND2,IPGND,IEXK
  15.       COMMON/GND/ZRATI,ZRATI2,FRATI,CL,CH,SCRWL,SCRWR,NRADL,KSYMP,
  16.      1 IFAR,IPERF,T1,T2
  17.       EQUIVALENCE (T1XJ,CABJ),(T1YJ,SABJ),(T1ZJ,SALPJ),(T2XJ,B),
  18.      1(T2YJ,IND1), (T2ZJ,IND2)
  19.       DATA FPI/12.56637062D0/,TP/6.283185308D0/
  20.       RX=XI-XJ
  21.       RY=YI-YJ
  22.       RFL=-1.
  23.       EXK=(0.,0.)
  24.       EYK=(0.,0.)
  25.       EZK=(0.,0.)
  26.       EXS=(0.,0.)
  27.       EYS=(0.,0.)
  28.       EZS=(0.,0.)
  29.       DO 5 IP=1,KSYMP
  30.       RFL=-RFL
  31.       RZ=ZI-ZJ*RFL
  32.       RSQ=RX*RX+RY*RY+RZ*RZ
  33.       IF (RSQ.LT.1.D-20) GO TO 5
  34.       R=DSQRT(RSQ)
  35.       RK=TP*R
  36.       CR=DCOS(RK)
  37.       SR=DSIN(RK)
  38.       GAM=-(DCMPLX(CR,-SR)+RK*DCMPLX(SR,CR))/(FPI*RSQ*R)*S
  39.       EXC=GAM*RX
  40.       EYC=GAM*RY
  41.       EZC=GAM*RZ
  42.       T1ZR=T1ZJ*RFL
  43.       T2ZR=T2ZJ*RFL
  44.       F1X=EYC*T1ZR-EZC*T1YJ
  45.       F1Y=EZC*T1XJ-EXC*T1ZR
  46.       F1Z=EXC*T1YJ-EYC*T1XJ
  47.       F2X=EYC*T2ZR-EZC*T2YJ
  48.       F2Y=EZC*T2XJ-EXC*T2ZR
  49.       F2Z=EXC*T2YJ-EYC*T2XJ
  50.       IF (IP.EQ.1) GO TO 4
  51.       IF (IPERF.NE.1) GO TO 1
  52.       F1X=-F1X
  53.       F1Y=-F1Y
  54.       F1Z=-F1Z
  55.       F2X=-F2X
  56.       F2Y=-F2Y
  57.       F2Z=-F2Z
  58.       GO TO 4
  59. 1     XYMAG=DSQRT(RX*RX+RY*RY)
  60.       IF (XYMAG.GT.1.D-6) GO TO 2
  61.       PX=0.
  62.       PY=0.
  63.       CTH=1.
  64.       RRV=(1.,0.)
  65.       GO TO 3
  66. 2     PX=-RY/XYMAG
  67.       PY=RX/XYMAG
  68.       CTH=RZ/R
  69. C      RRV=CSQRT(1.-ZRATI*ZRATI*(1.-CTH*CTH))
  70.       RRV=ZSQRT(1.-ZRATI*ZRATI*(1.-CTH*CTH))
  71. 3     RRH=ZRATI*CTH
  72.       RRH=(RRH-RRV)/(RRH+RRV)
  73.       RRV=ZRATI*RRV
  74.       RRV=-(CTH-RRV)/(CTH+RRV)
  75.       GAM=(F1X*PX+F1Y*PY)*(RRV-RRH)
  76.       F1X=F1X*RRH+GAM*PX
  77.       F1Y=F1Y*RRH+GAM*PY
  78.       F1Z=F1Z*RRH
  79.       GAM=(F2X*PX+F2Y*PY)*(RRV-RRH)
  80.       F2X=F2X*RRH+GAM*PX
  81.       F2Y=F2Y*RRH+GAM*PY
  82.       F2Z=F2Z*RRH
  83. 4     EXK=EXK+F1X
  84.       EYK=EYK+F1Y
  85.       EZK=EZK+F1Z
  86.       EXS=EXS+F2X
  87.       EYS=EYS+F2Y
  88.       EZS=EZS+F2Z
  89. 5     CONTINUE
  90.       RETURN
  91.       END
  92. C
  93. C
  94. C
  95.       SUBROUTINE TRIO(SI,BI,ICON1,ICON2,J,LD)
  96. C     COMPUTE THE COMPONENTS OF ALL BASIS FUNCTIONS ON SEGMENT J
  97.       INTEGER*4 ICON1,ICON2,N1,N2,N,NP,M1,M2,M,MP,IPSYM,J,JCOX
  98.       REAL*8 AX,BX,CX
  99.       COMMON/DATAD/N1,N2,N,NP,M1,M2,M,MP,IPSYM,WLAM
  100.       COMMON/SEGJ/AX(30),BX(30),CX(30),JCO(30),JSNO,ISCON(50),NSCON,
  101.      1 IPCON(10),NPCON
  102.       DIMENSION SI(LD),BI(LD),ICON1(LD),ICON2(LD)
  103.       DATA JMAX/30/
  104. C**
  105. C     E      WRITE(*,*) '    TRIO: J=',J,' N1=',N1
  106. C**
  107.       JSNO=0
  108.       JCOX=ICON1(J)
  109.       IF (JCOX.GT.10000) GO TO 7
  110.       JEND=-1
  111.       IEND=-1
  112.       IF (JCOX) 1,7,2
  113. 1     JCOX=-JCOX
  114.       GO TO 3
  115. 2     JEND=-JEND
  116. 3     IF (JCOX.EQ.J) GO TO 6
  117.       JSNO=JSNO+1
  118.       IF (JSNO.GE.JMAX) GO TO 9
  119.       CALL SBF(AX(JSNO),BX(JSNO),CX(JSNO),SI,BI,
  120.      1 ICON1,ICON2,JCOX,J,LD)
  121.       JCO(JSNO)=JCOX
  122.       IF (JEND.EQ.1) GO TO 4
  123.       JCOX=ICON1(JCOX)
  124.       GO TO 5
  125. 4     JCOX=ICON2(JCOX)
  126. 5     IF (JCOX) 1,9,2
  127. 6     IF (IEND.EQ.1) GO TO 8
  128. 7     JCOX=ICON2(J)
  129.       IF (JCOX.GT.10000) GO TO 8
  130.       JEND=1
  131.       IEND=1
  132.       IF (JCOX) 1,8,2
  133. 8     JSNO=JSNO+1
  134.       CALL SBF(AX(JSNO),BX(JSNO),CX(JSNO),SI,BI,
  135.      1 ICON1,ICON2,J,J,LD)
  136.       JCO(JSNO)=J
  137.       RETURN
  138. 9     WRITE(*,10)  J
  139.       STOP
  140. C
  141. 10    FORMAT (44H TRIO - SEGMENT CONNENTION ERROR FOR SEGMENT,I5)
  142.       END
  143. C
  144. C
  145. C
  146.       SUBROUTINE SBF(AA,BB,CC,SI,BI,ICON1,ICON2,I,IS,LD)
  147. C     COMPUTE COMPONENT OF BASIS FUNCTION I ON SEGMENT IS.
  148.       INTEGER*4 ICON1,ICON2,N1,N2,N,NP,M1,M2,M,MP,IPSYM,I,IS,JCOX
  149.       COMMON/DATAD/N1,N2,N,NP,M1,M2,M,MP,IPSYM,WLAM
  150.       DIMENSION SI(LD),BI(LD),ICON1(LD),ICON2(LD)
  151.       REAL*8 PI,SDH,CDH,AA,BB,CC,D,SD,CD,OMC,AJ,AP,PP,PM,QP,QM,XXI
  152.       DATA PI/3.141592654D0/,JMAX/30/
  153. C**
  154. C     E      WRITE(*,*) '    SBF: I=',I,' IS=',IS
  155.       LD=LD
  156. C**
  157.       AA=0.
  158.       BB=0.
  159.       CC=0.
  160.       JUNE=0
  161.       JSNO=0
  162.       PP=0.
  163.       JCOX=ICON1(I)
  164.       IF (JCOX.GT.10000) JCOX=I
  165.       JEND=-1
  166.       IEND=-1
  167.       SIG=-1.
  168.       IF (JCOX) 1,11,2
  169. 1     JCOX=-JCOX
  170.       GO TO 3
  171. 2     SIG=-SIG
  172.       JEND=-JEND
  173. 3     JSNO=JSNO+1
  174.       IF (JSNO.GE.JMAX) GO TO 24
  175.       D=PI*SI(JCOX)
  176.       SDH=DSIN(D)
  177.       CDH=DCOS(D)
  178.       SD=2.*SDH*CDH
  179.       IF (D.GT.0.015) GO TO 4
  180.       OMC=4.*D*D
  181.       OMC=((1.3888889D-3*OMC-4.1666666667D-2)*OMC+.5)*OMC
  182.       GO TO 5
  183. 4     OMC=1.-CDH*CDH+SDH*SDH
  184. 5     AJ=1./(DLOG(1./(PI*BI(JCOX)))-.577215664D0)
  185. C**
  186.       PP=PP-OMC/SD*AJ
  187.       IF (JCOX.NE.IS) GO TO 6
  188.       AA=AJ/SD*SIG
  189.       BB=AJ/(2.*CDH)
  190.       CC=-AJ/(2.*SDH)*SIG
  191.       JUNE=IEND
  192. 6     IF (JCOX.EQ.I) GO TO 9
  193.       IF (JEND.EQ.1) GO TO 7
  194.       JCOX=ICON1(JCOX)
  195.       GO TO 8
  196. 7     JCOX=ICON2(JCOX)
  197. 8     IF (IABS(JCOX).EQ.I) GO TO 10
  198.       IF (JCOX) 1,24,2
  199. 9     IF (JCOX.EQ.IS) BB=-BB
  200. 10    IF (IEND.EQ.1) GO TO 12
  201. 11    PM=-PP
  202.       PP=0.
  203.       NJUN1=JSNO
  204.       JCOX=ICON2(I)
  205.       IF (JCOX.GT.10000) JCOX=I
  206.       JEND=1
  207.       IEND=1
  208.       SIG=-1.
  209.       IF (JCOX) 1,12,2
  210. 12    NJUN2=JSNO-NJUN1
  211.       D=PI*SI(I)
  212.       SDH=DSIN(D)
  213.       CDH=COS(D)
  214.       SD=2.*SDH*CDH
  215.       CD=CDH*CDH-SDH*SDH
  216.       IF (D.GT.0.015) GO TO 13
  217.       OMC=4.*D*D
  218.       OMC=((1.3888889D-3*OMC-4.1666666667D-2)*OMC+.5)*OMC
  219.       GO TO 14
  220. 13    OMC=1.-CD
  221. 14    AP=1./(DLOG(1./(PI*BI(I)))-.577215664D0)
  222.       AJ=AP
  223.       IF (NJUN1.EQ.0) GO TO 19
  224.       IF (NJUN2.EQ.0) GO TO 21
  225.       QP=SD*(PM*PP+AJ*AP)+CD*(PM*AP-PP*AJ)
  226.       QM=(AP*OMC-PP*SD)/QP
  227.       QP=-(AJ*OMC+PM*SD)/QP
  228.       IF (JUNE) 15,18,16
  229. 15    AA=AA*QM
  230.       BB=BB*QM
  231.       CC=CC*QM
  232.       GO TO 17
  233. 16    AA=-AA*QP
  234.       BB=BB*QP
  235.       CC=-CC*QP
  236. 17    IF (I.NE.IS) RETURN
  237. 18    AA=AA-1.
  238.       BB=BB+(AJ*QM+AP*QP)*SDH/SD
  239.       CC=CC+(AJ*QM-AP*QP)*CDH/SD
  240.       RETURN
  241. 19    IF (NJUN2.EQ.0) GO TO 23
  242.       QP=PI*BI(I)
  243.       XXI=QP*QP
  244.       XXI=QP*(1.-.5*XXI)/(1.-XXI)
  245.       QP=-(OMC+XXI*SD)/(SD*(AP+XXI*PP)+CD*(XXI*AP-PP))
  246.       IF (JUNE.NE.1) GO TO 20
  247.       AA=-AA*QP
  248.       BB=BB*QP
  249.       CC=-CC*QP
  250.       IF (I.NE.IS) RETURN
  251. 20    AA=AA-1.
  252.       D=CD-XXI*SD
  253.       BB=BB+(SDH+AP*QP*(CDH-XXI*SDH))/D
  254.       CC=CC+(CDH+AP*QP*(SDH+XXI*CDH))/D
  255.       RETURN
  256. 21    QM=PI*BI(I)
  257.       XXI=QM*QM
  258.       XXI=QM*(1.-.5*XXI)/(1.-XXI)
  259.       QM=(OMC+XXI*SD)/(SD*(AJ-XXI*PM)+CD*(PM+XXI*AJ))
  260.       IF (JUNE.NE.-1) GO TO 22
  261.       AA=AA*QM
  262.       BB=BB*QM
  263.       CC=CC*QM
  264.       IF (I.NE.IS) RETURN
  265. 22    AA=AA-1.
  266.       D=CD-XXI*SD
  267.       BB=BB+(AJ*QM*(CDH-XXI*SDH)-SDH)/D
  268.       CC=CC+(CDH-AJ*QM*(SDH+XXI*CDH))/D
  269.       RETURN
  270. 23    AA=-1.
  271.       QP=PI*BI(I)
  272.       XXI=QP*QP
  273.       XXI=QP*(1.-.5*XXI)/(1.-XXI)
  274.       CC=1./(CDH-XXI*SDH)
  275.       RETURN
  276. 24    WRITE(*,25)  I
  277.       STOP
  278. C
  279. 25    FORMAT (' SBF - SEGMENT CONNECTION ERROR FOR SEGMENT',I5)
  280.       END
  281. C
  282. C
  283. C
  284.       SUBROUTINE UNERE (XOB,YOB,ZOB)
  285. C     CALCULATES THE ELECTRIC FIELD DUE TO UNIT CURRENT IN THE T1 AND T2
  286. C     DIRECTIONS ON A PATCH
  287.       COMPLEX*16 ER,Q1,Q2,RRV,RRH,EDP
  288.       COMPLEX*16 EXK,EYK,EZK,EXS,EYS,EZS,EXC,EYC,EZC,ZRATI,ZRATI2,
  289.      1 T1,FRATI
  290.       INTEGER*4 IND1,IND2
  291.       REAL*4 T1XJ,T1YJ,T1ZJ,T2XJ,T2YJ,T2ZJ,CABJ,SABJ,SALPJ,B
  292.       REAL*8 TPI,CONST,XOB,YOB,ZOB,R,R2,RT,TT1,TT2,XYMAG,PX,PY,CTH
  293.       COMMON/DATAJ/S,B,XJ,YJ,ZJ,CABJ,SABJ,SALPJ,EXK,EYK,EZK,EXS,EYS,
  294.      1 EZS,EXC,EYC,EZC,RKH,IND1,IND2,IPGND,IEXK
  295.       COMMON/GND/ZRATI,ZRATI2,FRATI,CL,CH,SCRWL,SCRWR,NRADL,KSYMP,
  296.      1 IFAR,IPERF,T1,T2
  297.       EQUIVALENCE (T1XJ,CABJ),(T1YJ,SABJ),(T1ZJ,SALPJ),(T2XJ,B),
  298.      1(T2YJ,IND1), (T2ZJ,IND2)
  299.       DATA TPI,CONST/6.283185308D0,4.771341188D0/
  300. C     CONST=ETA/(8.*PI**2)
  301. C**
  302. C     E      WRITE(*,*) '    UNERE: XOB=',XOB,' YOB=',YOB,' ZOB=',ZOB
  303. C**
  304.       ZR=ZJ
  305.       T1ZR=T1ZJ
  306.       T2ZR=T2ZJ
  307.       IF (IPGND.NE.2) GO TO 1
  308.       ZR=-ZR
  309.       T1ZR=-T1ZR
  310.       T2ZR=-T2ZR
  311. 1     RX=XOB-XJ
  312.       RY=YOB-YJ
  313.       RZ=ZOB-ZR
  314.       R2=RX*RX+RY*RY+RZ*RZ
  315.       IF (R2.GT.1.D-20) GO TO 2
  316.       EXK=(0.,0.)
  317.       EYK=(0.,0.)
  318.       EZK=(0.,0.)
  319.       EXS=(0.,0.)
  320.       EYS=(0.,0.)
  321.       EZS=(0.,0.)
  322. C**
  323. C     E      WRITE(*,*) '    UNERE: EARLY RETURN'
  324. C**
  325.       RETURN
  326. 2     R=DSQRT(R2)
  327.       TT1=-TPI*R
  328.       TT2=TT1*TT1
  329.       RT=R2*R
  330.       ER=DCMPLX(DSIN(TT1),-DCOS(TT1))*(CONST*S)
  331.       Q1=CMPLX(TT2-1.,TT1)*ER/RT
  332.       Q2=CMPLX(3.-TT2,-3.*TT1)*ER/(RT*R2)
  333.       ER=Q2*(T1XJ*RX+T1YJ*RY+T1ZR*RZ)
  334.       EXK=Q1*T1XJ+ER*RX
  335.       EYK=Q1*T1YJ+ER*RY
  336.       EZK=Q1*T1ZR+ER*RZ
  337.       ER=Q2*(T2XJ*RX+T2YJ*RY+T2ZR*RZ)
  338.       EXS=Q1*T2XJ+ER*RX
  339.       EYS=Q1*T2YJ+ER*RY
  340.       EZS=Q1*T2ZR+ER*RZ
  341.       IF (IPGND.EQ.1) GO TO 6
  342.       IF (IPERF.NE.1) GO TO 3
  343.       EXK=-EXK
  344.       EYK=-EYK
  345.       EZK=-EZK
  346.       EXS=-EXS
  347.       EYS=-EYS
  348.       EZS=-EZS
  349.       GO TO 6
  350. C3     XYMAG=DSQRT(RX*RX+RY*RY)
  351. 3     XYMAG=SQRT(RX*RX+RY*RY)
  352.       IF (XYMAG.GT.1.D-6) GO TO 4
  353.       PX=0.
  354.       PY=0.
  355.       CTH=1.
  356.       RRV=(1.,0.)
  357.       GO TO 5
  358. 4     PX=-RY/XYMAG
  359.       PY=RX/XYMAG
  360.       CTH=RZ/DSQRT(XYMAG*XYMAG+RZ*RZ)
  361.       RRV=CDSQRT(1.-ZRATI*ZRATI*(1.-CTH*CTH))
  362. 5     RRH=ZRATI*CTH
  363.       RRH=(RRH-RRV)/(RRH+RRV)
  364.       RRV=ZRATI*RRV
  365.       RRV=-(CTH-RRV)/(CTH+RRV)
  366.       EDP=(EXK*PX+EYK*PY)*(RRH-RRV)
  367.       EXK=EXK*RRV+EDP*PX
  368.       EYK=EYK*RRV+EDP*PY
  369.       EZK=EZK*RRV
  370.       EDP=(EXS*PX+EYS*PY)*(RRH-RRV)
  371.       EXS=EXS*RRV+EDP*PX
  372.       EYS=EYS*RRV+EDP*PY
  373.       EZS=EZS*RRV
  374. 6      CONTINUE
  375. C**
  376. C     E      WRITE(*,*) '    UNERE: RETURN'
  377. C**
  378.       RETURN
  379.       END
  380. C
  381. C
  382. C
  383.       SUBROUTINE PCINT (XI,YI,ZI,CABI,SABI,SALPI,E)
  384. C     INTEGRATE OVER PATCHES AT WIRE CONNECTION POINT
  385.       COMPLEX*16 E
  386.       COMPLEX*16 EXK,EYK,EZK,EXS,EYS,EZS,EXC,EYC,EZC,E1,E2,E3,E4,E5,
  387.      1 E6,E7,E8,E9
  388.       INTEGER*4 IND1,IND2
  389.       REAL*4 T1XJ,T1YJ,T1ZJ,T2XJ,T2YJ,T2ZJ,CABJ,SABJ,SALPJ,B
  390.       REAL*8 TPI,XI,YI,ZI
  391.       COMMON/DATAJ/S,B,XJ,YJ,ZJ,CABJ,SABJ,SALPJ,EXK,EYK,EZK,EXS,EYS,
  392.      1 EZS,EXC,EYC,EZC,RKH,IND1,IND2,IPGND,IEXK
  393.       DIMENSION E(9)
  394.       EQUIVALENCE (T1XJ,CABJ),(T1YJ,SABJ),(T1ZJ,SALPJ),(T2XJ,B),
  395.      1(T2YJ,IND1), (T2ZJ,IND2)
  396.       DATA TPI/6.283185308D0/,NINT/10/
  397. C**
  398. C     E      WRITE(*,*) '    PCINT: XI=',XI,' YI=',YI,' ZI=',ZI
  399. C**
  400.       D=SQRT(S)*.5
  401.       DS=4.*D/FLOAT(NINT)
  402.       DA=DS*DS
  403.       GCON=1./S
  404.       FCON=1./(2.*TPI*D)
  405.       XXJ=XJ
  406.       XYJ=YJ
  407.       XZJ=ZJ
  408.       XS=S
  409.       S=DA
  410.       S1=D+DS*.5
  411.       XSS=XJ+S1*(T1XJ+T2XJ)
  412.       YSS=YJ+S1*(T1YJ+T2YJ)
  413.       ZSS=ZJ+S1*(T1ZJ+T2ZJ)
  414.       S1=S1+D
  415.       S2X=S1
  416.       E1=(0.,0.)
  417.       E2=(0.,0.)
  418.       E3=(0.,0.)
  419.       E4=(0.,0.)
  420.       E5=(0.,0.)
  421.       E6=(0.,0.)
  422.       E7=(0.,0.)
  423.       E8=(0.,0.)
  424.       E9=(0.,0.)
  425.       DO 1 I1=1,NINT
  426.       S1=S1-DS
  427.       S2=S2X
  428.       XSS=XSS-DS*T1XJ
  429.       YSS=YSS-DS*T1YJ
  430.       ZSS=ZSS-DS*T1ZJ
  431.       XJ=XSS
  432.       YJ=YSS
  433.       ZJ=ZSS
  434.       DO 1 I2=1,NINT
  435.       S2=S2-DS
  436.       XJ=XJ-DS*T2XJ
  437.       YJ=YJ-DS*T2YJ
  438.       ZJ=ZJ-DS*T2ZJ
  439.       CALL UNERE (XI,YI,ZI)
  440.       EXK=EXK*CABI+EYK*SABI+EZK*SALPI
  441.       EXS=EXS*CABI+EYS*SABI+EZS*SALPI
  442.       G1=(D+S1)*(D+S2)*GCON
  443.       G2=(D-S1)*(D+S2)*GCON
  444.       G3=(D-S1)*(D-S2)*GCON
  445.       G4=(D+S1)*(D-S2)*GCON
  446.       F2=(S1*S1+S2*S2)*TPI
  447.       F1=S1/F2-(G1-G2-G3+G4)*FCON
  448.       F2=S2/F2-(G1+G2-G3-G4)*FCON
  449.       E1=E1+EXK*G1
  450.       E2=E2+EXK*G2
  451.       E3=E3+EXK*G3
  452.       E4=E4+EXK*G4
  453.       E5=E5+EXS*G1
  454.       E6=E6+EXS*G2
  455.       E7=E7+EXS*G3
  456.       E8=E8+EXS*G4
  457. 1     E9=E9+EXK*F1+EXS*F2
  458.       E(1)=E1
  459.       E(2)=E2
  460.       E(3)=E3
  461.       E(4)=E4
  462.       E(5)=E5
  463.       E(6)=E6
  464.       E(7)=E7
  465.       E(8)=E8
  466.       E(9)=E9
  467.       XJ=XXJ
  468.       YJ=XYJ
  469.       ZJ=XZJ
  470.       S=XS
  471.       RETURN
  472.       END
  473.